home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Disc to the Future 2
/
Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin
/
PC
/
MISCBAS
/
SQUARE.ASC
< prev
next >
Wrap
Text File
|
1987-01-11
|
7KB
|
200 lines
100 REM ** SQUARE **
110 REM
120 REM WRITTEN BY MAC OGLESBY
130 REM AS DESCRIBED IN VOL. 1, ISSUE 3
140 REM OF CALCULATORS-COMPUTERS MAGAZINE
150 REM
160 CS$=CHR$(126)+CHR$(28) 'CURSOR CONTROL CODES TO CLEAR SCREEN
170 DEFINT A-Z
180 PRINTCS$;"ENTER PASSWORD";:INPUTA$:Z=0
190 A=0:FORI=1TOLEN(A$):A=A+ASC(MID$(A$,I,1)):NEXT:A=RND(-A)
200 DIM Q(50),S$(50),S(24,12),U(12),V(50)
210 P$(1)="X":P$(2)="O":F=1
220 FOR R0=0 TO 4:FOR C0=0 TO 4:D$(R0,C0)=".":NEXTC0:NEXTR0
230 INPUT"WANT INSTRUCTIONS FOR 'SQUARE'";A$
240 IFLEFT$(A$,1)="N"THEN400
250 PRINTCS$; 'CLEAR SCREEN
260 PRINT" THE GAME OF SQUARE IS FOR 1 OR 2 PLAYERS. THE NORMAL"
270 PRINT"BOARD LOOKS LIKE THIS AT THE START:":GOSUB2000
280 PRINT" THE PLAYERS GO IN TURN AND CHOOSE ANY UNOCCUPIED POINT"
290 PRINT"(SHOWN AS A DOT). EACH PLAYER HAS 12 MARKERS (X'S OR O'S)"
300 PRINT"WHICH ARE USED TO IDENTIFY CHOSEN POINTS.":PRINT
310 INPUT" ENTER 'C' TO CONTINUE";A$:PRINT
320 PRINT" THE WINNER IS THE FIRST PLAYER WHO HAS CHOSEN 4 POINTS"
330 PRINT"WHICH FORM THE CORNERS OF A SQUARE."
340 PRINT" TO CHOOSE A POINT, TYPE 2 DIGITS (0 TO 4) SEPARATED BY A"
350 PRINT"COMMA. THE FIRST DIGIT TELLS THE DISTANCE OVER (TO T";
360 PRINT"HE RIGHT)":PRINT"FROM POINT 0,0 (THE ORIGIN). THE SECOND";
370 PRINT" DIGIT TELLS THE DISTANCE UP.":PRINT
380 PRINT"REMEMBER: OVER,UP.":PRINT
390 INPUT" ENTER 'C' TO CONTINUE";A$:PRINT
400 PRINT:INPUT"DO YOU WANT TO PLAY THE EXPERTS' GAME";A$
410 B0=1:IFLEFT$(A$,1)="Y"THENB0=2
420 IFB0=1THEN440
430 D$(2,2)=" ":N=38:GOTO450
440 N=50
450 IFZ=1THENGOTO490ELSEPRINT:INPUT"HOW MANY PLAYERS (1 OR 2)";P0
460 IFP0=2THEN510
470 IF P0=1THEN480ELSEPRINT"PLEASE ENTER 1 OR 2":GOTO450
480 PRINTCS$;"OK, I WILL PLAY THE X'S":PRINT
490 INPUT"DO YOU WANT TO GO FIRST";A$:F=1
500 IFLEFT$(A$,1)="Y"THENF=2
510 PRINTCS$;"OK...HERE WE GO..."
520 IFZ=1THEN940
530 RESTORE:FORJ=0TO24:READS(J,0):NEXT
540 DATA 4,7,8,7,4,7,10,11,10,7,8,11,12,11,8,7,10,11,10,7,4,7,8,7,4
550 FORJ=0TO24:FORK=1TOS(J,0):READS(J,K):NEXTK:NEXTJ
560 DATA 1,13,35,43
570 DATA 1,2,15,20,28,31,36
580 DATA 2,3,21,24,29,43,44,47
590 DATA 3,4,16,25,30,31,35
600 DATA 4,13,36,44
610 DATA 1,5,15,24,30,32,37
620 DATA 1,2,5,14,22,25,38,39,47,48
630 DATA 2,3,15,16,17,23,26,32,33,39,40
640 DATA 3,4,6,14,20,27,37,40,47,49
650 DATA 4,6,16,21,28,33,38
660 DATA 5,7,20,26,29,43,45,48
670 DATA 5,7,15,17,18,21,27,31,34,39,41
680 DATA 39,40,41,42,43,44,45,46,47,48,49,50
690 DATA 6,8,16,17,19,22,24,31,34,40,42
700 DATA 6,8,23,25,29,44,46,49
710 DATA 7,9,18,22,28,32,35
720 DATA 7,9,10,14,23,24,36,41,48,50
730 DATA 10,11,17,18,19,20,25,32,33,41,42
740 DATA 8,11,12,14,21,26,35,42,49,50
750 DATA 8,12,19,27,30,33,36
760 DATA 9,13,37,45
770 DATA 9,10,18,26,30,34,38
780 DATA 10,11,22,27,29,45,46,50
790 DATA 11,12,19,23,28,34,37
800 DATA 12,13,38,46
810 FORJ=1TON:READS$(J):NEXT
820 DATA 00011110,01021211,02031312,03041413,10112120
830 DATA 13142423,20213130,23243433,30314140,31324241
840 DATA 32334342,33344443,00044440,11133331
850 DATA 01122110,03142312,12233221,21324130,23344332
860 DATA 01133220,02143321,11234230,12244331
870 DATA 02233110,03243211,12334120,13344221
880 DATA 01144330,02244220,03344110
890 DATA 01032321,10123230,12143432,21234341
900 DATA 00033330,01043431,10134340,11144441
910 DATA 11122221,12132322,21223231,22233332
920 DATA 00022220,02042422,20224240,22244442
930 DATA 02132211,11223120,13243322,22334231
940 IFA(1)<>89THEN960
950 IFB0=2THEN960ELSEPRINT:GOTO970
960 GOSUB2000
970 T=T+1
980 REM ** MAIN MOVE LOOP: J=121212... OR J=212121...
990 FORJ=FTO3-FSTEP3-2*F
1000 IFP0=2THEN1730
1010 IFJ=2THEN1730
1020 REM ** GENERATE COMPUTER'S MOVE
1030 IFT<>1THEN1100
1040 IFD$(2,2)<>"."THEN1060
1050 R1=2:C1=2:GOTO1710
1060 IFF=1THEN1080
1070 Q0=9:GOTO1130
1080 R1=1+INT(RND(1)*3):C1=1+INT(RND(1)*3)
1090 IFD$(R1,C1)<>"."THENGOTO1080ELSEGOTO1710
1100 IFT<>2THEN1380
1110 IFF=1THEN1130
1120 Q0=19
1130 K9=0
1140 FORJ1=1TON:IFQ(J1)<>1+Q0THEN1160
1150 K9=K9+1:U(K9)=J1
1160 NEXTJ1
1170 IFK9=0THEN1370
1180 FORJ2=K9TO1STEP-1:T9=1+INT(RND(1)*J2):J1=U(T9)
1190 FORK1=1TO8STEP2:R1=VAL(MID$(S$(J1),K1,1))
1200 C1=VAL(MID$(S$(J1),K1+1,1))
1210 IFD$(R1,C1)<>"."THEN1320
1220 IFQ0+T<3THEN1240
1230 GOTO1710
1240 S0=5*R1+C1:M0=0:FORJ3=1TOS(S0,0)
1250 IFB0=1THEN1280
1260 IFS(S0,J3)<=38THEN1280
1270 GOTO1310
1280 IFQ(S(S0,J3))>1THEN1300
1290 M0=M0+1
1300 NEXTJ3
1310 IFM0<8-B0THENGOTO1320ELSEGOTO1710
1320 NEXTK1
1330 IFJ2=T9THEN1350
1340 T8=U(J2):U(J2)=U(T9):U(T9)=T8
1350 NEXTJ2
1360 REM *** AS A LAST RESORT, PICK ANY VACANT POINT
1370 R1=RND(1)*5:C1=RND(1)*5:IFD$(R1,C1)<>"."THENGOTO1370ELSEGOTO1710
1380 IFT=3THEN1430
1390 REM ** SEE IF 'X' CAN COMPLETE A SQUARE
1400 FORJ1=1TON:IFQ(J1)<>3THENGOTO1410ELSEGOTO1190
1410 NEXTJ1
1420 REM ** SEE IF 'O' CAN COMPLETE A SQUARE
1430 FORJ1=1TON:IFQ(J1)<>30THENGOTO1440ELSEGOTO1190
1440 NEXTJ1
1450 REM ** CAN 'X' CHOOSE A 3RD CORNER?
1460 K9=0:FORJ1=1TON:IFQ(J1)<>2THEN1480
1470 K9=K9+1:U(K9)=J1
1480 NEXTJ1
1490 IFK9=0THEN1700
1500 FORI0=1TO2:FORJ0=K9TO1STEP-1:M9=1+INT(RND(1)*J0):J1=U(M9):T9=0
1510 FORK1=1TO8STEP2:R1=VAL(MID$(S$(J1),K1,1))
1520 C1=VAL(MID$(S$(J1),K1+1,1)):IFD$(R1,C1)<>"."THEN1540
1530 T9=T9+1:R(T9)=R1:C(T9)=C1
1540 NEXTK1
1550 FORJ2=1TO2:FORJ3=1TO50:V(J3)=Q(J3):NEXTJ3:S0=5*R(J2)+C(J2)
1560 FORJ3=1TOS(S0,0):V(S(S0,J3))=V(S(S0,J3))+1:NEXTJ3
1570 S0=5*R(3-J2)+C(3-J2)
1580 FORJ3=1TOS(S0,0):V(S(S0,J3))=V(S(S0,J3))+10:NEXTJ3
1590 FORJ3=1TON:IFV(J3)<>4-I0THEN1610
1600 R1=R(J2):C1=C(J2):GOTO1710
1610 NEXTJ3
1620 NEXTJ2
1630 IFJ0=M9THEN1650
1640 T8=U(J0):U(J0)=U(M9):U(M9)=T8
1650 NEXTJ0
1660 NEXTI0
1670 REM ** NO GOOD MOVE AVAILABLE...PICK ANY 3RD CORNER
1680 J1=U(1+INT(RND(1)*K9)):GOTO1190
1690 REM ** SEE IF WE CAN ANNOY THE HUMAN
1700 Q0=I9:GOTO1130
1710 PRINT"THE ";P$(J);"'S MOVE TO ";STR$(C1);",";STR$(R1):GOTO1780
1720 REM ** GET PLAYER'S CHOICE
1730 IFT>1THEN1750
1740 PRINT"THE ";P$(J);"'S MOVE TO WHICH POINT";:GOTO1760
1750 PRINTP$(J);"'S CHOICE";
1760 INPUTC1,R1
1770 IFD$(R1,C1)<>"."THEN1850
1780 D$(R1,C1)=P$(J)
1790 REM ** Q() TELLS WHO OWNS CORNERS OF WHICH SQUARES
1800 S0=5*R1+C1:FORJ1=1TOS(S0,0):Q(S(S0,J1))=Q(S(S0,J1))+1+(J-1)*9
1810 IFQ(S(S0,J1))<>4+(J-1)*36THEN1830
1820 PRINT:PRINT"*** THE ";P$(J);"'S WIN!! ***":GOTO1910
1830 NEXTJ1
1840 GOTO1880
1850 PRINT"** ILLEGAL POINT! **":GOTO1870
1860 PRINT"YOU MUST TYPE 2 DIGITS (0 TO 4) SEPARATED BY A COMMA!"
1870 PRINT"** INPUT IGNORED! PLEASE TRY AGAIN...":GOTO1750
1880 NEXTJ
1890 IFT<12THEN1970
1900 PRINT:PRINT"THE GAME IS A DRAW; NEITHER PLAYER MADE A SQUARE!"
1910 FORK1=1TO8STEP2:R1=VAL(MID$(S$(S(S0,J1)),K1,1))
1920 C1=VAL(MID$(S$(S(S0,J1)),K1+1,1)):D$(R1,C1)=CHR$(64):NEXT:GOSUB2000
1930 INPUT"WANT TO PLAY AGAIN";A$:IFLEFT$(A$,1)<>"Y"THENEND
1940 Z=1:FORJ2=0TO4:FORJ3=0TO4:D$(J2,J3)=".":NEXTJ3:NEXTJ2
1950 FORJ2=1TO50:Q(J2)=0:V(J2)=0:NEXTJ2:FORJ2=1TO12:U(J2)=0:NEXTJ2
1960 T=0:K9=0:GOTO400
1970 GOSUB2000
1980 GOTO970
1990 REM ** PRINT THE BOARD
2000 PRINT:FORR0=4TO0STEP-1:PRINTSTR$(R0);" ";
2010 FORC0=0TO4:PRINTD$(R0,C0);:IFC0=4THEN2030
2020 PRINT" ";
2030 NEXTC0:PRINT:IFR0=0THEN2050
2040 PRINT:PRINT
2050 NEXTR0:PRINT:PRINT" 0 1 2 3 4":PRINT:RETURN
2060 END
NEXTC0:PRINT:IFR0=0THEN2050
2040 PRINT:PRINT
2050 NEXTR0:PRINT:PRINT" 0 1 2 3 4":PRINT